home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 30
/
Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso
/
Aminet
/
dev
/
basic
/
Mildred.lha
/
lha
/
Bounce9.lha
/
Bounce9.ascii
< prev
next >
Wrap
Text File
|
1999-01-20
|
15KB
|
507 lines
WBStartup
.Variables
CPUminimum.b=Processor
PrefDisplayDepth.w=8
*ScrVP._ViewPort=0
IsAGA.b=False
Multitasking.b=True ; Default
Dim PlanarBuf.l(2) ; Base address of planar memory to output c2p to (allowed up to triple buffers)
.Prefs
PrefDisplayID.l=$0 ; Default (unspecified, as it may possibly retarget (doublescan etc))
;PrefDisplayID.l=$21000 ; AGA Lores PAL 320x256 non-laced single-scan 50Hz
;PrefDisplayID.l=$A1000 ; AGA Lores DoublePAL 384x275 non-laced double-scan 48Hz
;PrefDisplayID.l=$89000 ; AGA Lores Super72 384x290 non-laced single-scan 71Hz
;PrefDisplayID.l=$11000 ; AGA Lores NTSC 320x200 non-laced single-scan 60Hz
;PrefDisplayID.l=$39000 ; AGA Lores Multiscan 320x240 double-scan 58Hz
;PrefDisplayID.l=$59000 ; AGA Lores HighGFX 512x250 non-laced single-scan 54Hz
;PrefDisplayID.l=$69000 ; AGA Lores Euro72 320x200 non-laced double-scan 69Hz
;PrefDisplayID.l=$91000 ; AGA Lores DoubleNTSC 384x227 non-laced double-scan 58Hz
;PrefDisplayID.l=$29004 ; AGA PAL 640x400 Hires laced single-scan 50Hz
;PrefDisplayID.l=$19004 ; AGA NTSC 640x400 Hires laced single-scan 60Hz
;PrefDisplayID.l=$39024 ; AGA Multiscan 640x400 Hires non-laced single-scan 58Hz
;PrefDisplayID.l=$69024 ; AGA Euro72 640x400 Hires non-laced single-scan 69Hz
;PrefDisplayID.l=$A9004 ; AGA DoublePAL 640x400 Hires non-laced double-scan 48Hz
;PrefDisplayID.l=$99004 ; AGA DoubleNTSC 640x400 Hires non-laced double-scan 58Hz
PrefDisplayWidth.w=320
PrefDisplayHeight.w=240
PrefDisplayBuffering.b=1 ; 1..3
;If Joyb(0)=0 AND Joyb(1)=0 Then Goto PrefsSkip
#DTAG_DISP=$80000000
#DTAG_DIMS=$80001000
#DTAG_MNTR=$80002000
#DTAG_NAME=$80003000
NEWTYPE.SMode
DID.l
DWidth.l
DHeight.l
DDepth.w
DType.w
End NEWTYPE
DEFTYPE.Hook myhook ; The hook for ASL tag as &myhook
myhook\h_Entry=?hook
MOVE.l a5,globalbase
funcret.l=0
Dim SMRtags.TagItem(17)
SMRtags(0)\ti_Tag=#ASLSM_InitialLeftEdge,160
SMRtags(1)\ti_Tag=#ASLSM_InitialTopEdge,0
SMRtags(2)\ti_Tag=#ASLSM_InitialWidth,300
SMRtags(3)\ti_Tag=#ASLSM_InitialHeight,600
SMRtags(4)\ti_Tag=#ASLSM_InitialDisplayID,$21000
SMRtags(5)\ti_Tag=#ASLSM_InitialDisplayDepth,8
SMRtags(6)\ti_Tag=#ASLSM_InitialDisplayWidth,PrefDisplayWidth
SMRtags(7)\ti_Tag=#ASLSM_InitialDisplayHeight,PrefDisplayHeight
SMRtags(8)\ti_Tag=#ASLSM_InitialOverscanType,1
SMRtags(9)\ti_Tag=#ASLSM_InitialInfoOpened,1
SMRtags(10)\ti_Tag=#ASLSM_InitialInfoLeftEdge,350
SMRtags(11)\ti_Tag=#ASLSM_InitialInfoTopEdge,50
SMRtags(12)\ti_Tag=#ASLSM_DoDepth,0
SMRtags(13)\ti_Tag=#ASLSM_DoOverscanType,1
SMRtags(14)\ti_Tag=#ASLSM_DoWidth,1
SMRtags(15)\ti_Tag=#ASLSM_DoHeight,1
SMRtags(16)\ti_Tag=#ASLSM_FilterFunc,&myhook
SMRtags(17)\ti_Tag=#TAG_DONE,0
*sreq.SMode=0
*sreq=AllocAslRequest_(2,&SMRtags(0)\ti_Tag)
ok.b=AslRequest_(*sreq,&SMRtags(0)\ti_Tag)
If ok<>0
PrefDisplayID.l=*sreq\DID
PrefDisplayWidth.w=*sreq\DWidth
PrefDisplayHeight.w=*sreq\DHeight
EndIf
If (*sreq) Then FreeAslRequest_(*sreq)
Goto PrefsSkip
;*************************************************************************
; This is the statement that the hook will call. Put the label before
; the statement you want to jump to.
Runerrsoff
.hook_jump:
Statement hook{*dahook.Hook, modeID.l, *smr.ScreenModeRequester}
; We're inside the hook, and supposedly we should be able to do whatever
; we want.
; Filter modeID's here
SHARED funcret.l
DEFTYPE.DisplayInfo DisInfoBuf
DEFTYPE.DimensionInfo DimInfoBuf
DEFTYPE.MonitorInfo MonInfoBuf
DEFTYPE.NameInfo NamInfoBuf
;Refer to Includes/Graphics/DisplayInfo.h or view newtypes
IDhandle.l=FindDisplayInfo_(modeID)
GetDisplayInfoData_ IDhandle,&DisInfoBuf,SizeOf.DisplayInfo,#DTAG_DISP,0
GetDisplayInfoData_ IDhandle,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
GetDisplayInfoData_ IDhandle,&MonInfoBuf,SizeOf.MonitorInfo,#DTAG_MNTR,0
GetDisplayInfoData_ IDhandle,&NamInfoBuf,SizeOf.NameInfo,#DTAG_NAME,0
;Do tests. True=Mode is valid, False=mode is invalid.
If DimInfoBuf\MaxDepth<>8
;No true-colour modes, only 8-bit
funcret=False
Else
funcret=True
EndIf
End Statement
;**********************
; Hook
Macro goto_hook
JSR `1+6
End Macro
globalbase: Dc.l 0
hook: ;This hook is called by the filter hook callback from screenmode requester, per item
; Store registers
MOVEM.l d1-d7/a0-a6,-(a7) ; Not d0!
; Put parameters into dregs ready for a statement
MOVE.l a0,d0
MOVE.l a1,d1
MOVE.l a2,d2
; Get global variable base
MOVE.l globalbase,a5
; Goto hook statement
!goto_hook{hook_jump}
GetReg d0,funcret ; return accept/discard
; Restore registers
MOVEM.l (a7)+,d1-d7/a0-a6 ; Not d0!
RTS
;**********************
Runerrson
PrefsSkip
.Display
Statement Permit{}
;Permit multitasking, only if it is globally intended
SHARED Multitasking.b
If Multitasking Then Permit_
End Statement
Statement Forbid{}
;Disable multitasking, if it isn't globally intended
SHARED Multitasking.b
If Multitasking Then Forbid_
End Statement
Statement Multitasking{State.b}
;Toggle global multitasking on or off.
SHARED Multitasking.b
If State
If Multitasking=False Then Permit_
Else
If Multitasking Then Forbid_
EndIf
Multitasking=State
End Statement
Function.b InitDisplay{Title$}
;Creates a display
;Title$=The screen title (not displayed)
SHARED PrefDisplayHeight.w,PrefDisplayID.l,PrefDisplayBuffering.b,*ScrVP._ViewPort,IsAGA.b
SHARED PrefDisplayLeft.w,PrefDisplayTop.w
SHARED PrefDisplayDepth.w,PrefDisplayWidth.w,CPUminimum.b
SHARED PlanarBuf()
;Open a test screen first to a) test for AGA or GFX-Card, and b) because the dimensions might be
;too large to open a chipram screen, and the dimensions for AGA have not yet been reduced to within limits
Dim ScrTags.TagItem(13)
Rect.Rectangle\MinX=0,0,320,240 ; For test
ScrTags(0)\ti_Tag=#SA_Width,320 ; For test
ScrTags(1)\ti_Tag=#SA_Height,240; For test
ScrTags(2)\ti_Tag=#SA_Depth,PrefDisplayDepth
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
ScrTags(4)\ti_Tag=#SA_Type,$F
ScrTags(5)\ti_Tag=#SA_Quiet,True
ScrTags(6)\ti_Tag=#SA_ShowTitle,False
ScrTags(7)\ti_Tag=#SA_Behind,True
ScrTags(8)\ti_Tag=#SA_DClip,&Rect ; For test
ScrTags(9)\ti_Tag=#SA_Exclusive,False
ScrTags(10)\ti_Tag=#SA_Draggable,True
ScrTags(11)\ti_Tag=#SA_AutoScroll,True
ScrTags(12)\ti_Tag=#TAG_DONE,0
ScrTags(13)\ti_Tag=#TAG_DONE,0
UsedChip.l=(320 LSR 3)*PrefDisplayDepth*240 ; With test params
FreeChip.l=AvailMem_(#MEMF_CHIP)
Forbid{}
If ScreenTags(0,Title$,&ScrTags(0))<>0 ; Test for GFX-Card or AGA
NowChip.l=AvailMem_(#MEMF_CHIP)
Permit{}
If FreeChip-NowChip<UsedChip
; Graphics card screen
IsAGA=False
PrefDisplayWidth AND $FFF0 ; For gfx-cards, width to nearest 16
ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight*PrefDisplayBuffering
ScrTags(8)\ti_Tag=#SA_DClip,&Rect
VWait 5 ; seems to be necessary (safer)
Free Screen 0
VWait 5 ; just to be on the safe side
If ScreenTags(0,Title$,&ScrTags(0))<>0
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If Window(Loop,0,PrefDisplayHeight*Loop,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
ScreensBitMap 0,Loop
*TmpBmp.bitmap=Addr BitMap(Loop)
Offset.l=*TmpBmp\_ebwidth*(PrefDisplayHeight*Loop)
For DLoop.w=0 To PrefDisplayDepth-1
*TmpBmp\_data[DLoop]=*TmpBmp\_data[DLoop]+Offset
Next DLoop
Next Loop
Else
Function Return False
EndIf
Else
; AGA screen
IsAGA=True
PrefDisplayWidth AND $FFC0 ; For AGA, width to nearest 64
ScrTags(0)\ti_Tag=#SA_Width,PrefDisplayWidth
Rect.Rectangle\MinX=0,0,PrefDisplayWidth,PrefDisplayHeight
ScrTags(1)\ti_Tag=#SA_Height,PrefDisplayHeight ; Seperate buffers
ScrTags(8)\ti_Tag=#SA_DClip,&Rect
ScrTags(3)\ti_Tag=#SA_DisplayID,PrefDisplayID
Forbid{}
VWait 5 ; seems to be necessary (safer)
Free Screen 0
For Loop.w=0 To PrefDisplayBuffering-1
If Loop=0 Then WFlags.l=$1900 Else WFlags.l=$800
If AvailMem_(#MEMF_CHIP)>=(PrefDisplayWidth*PrefDisplayHeight)+16
Memory.l=AllocMem((PrefDisplayWidth*PrefDisplayHeight)+16,$10002) ; Chip bitmap
Memory=(Memory+16) AND $FFFFFFF0 ; Align for move16's
If Memory<>0
CludgeBitMap Loop,PrefDisplayWidth,PrefDisplayHeight,PrefDisplayDepth,Memory
If Loop=0
ScrTags(12)\ti_Tag=#SA_BitMap,Addr BitMap(0)
If ScreenTags(0,Title$,&ScrTags(0))=0
Permit{}
Function Return False
EndIf
EndIf
If Window(Loop,0,0,PrefDisplayWidth,PrefDisplayHeight,WFlags,"",0,0)=0 Then Function Return False
Menus Off
Else
Permit{}
Function Return False
EndIf
Else
Permit{}
Function Return False
EndIf
PlanarBuf(Loop)=Memory
Next Loop
Permit{}
EndIf
DEFTYPE.DimensionInfo DimInfoBuf
GetDisplayInfoData_ FindDisplayInfo_(PrefDisplayID) AND $FFFFFFFF,&DimInfoBuf,SizeOf.DimensionInfo,#DTAG_DIMS,0
PrefDisplayLeft.w=((DimInfoBuf\TxtOScan\MaxX)-PrefDisplayWidth)/2
PrefDisplayTop.w=((DimInfoBuf\TxtOScan\MaxY)-PrefDisplayHeight)/2
*Scr._Screen=Peek.l(Addr Screen(0))
*ScrVP=ViewPort(0)
*ScrVP\DxOffset=PrefDisplayLeft,PrefDisplayTop
ScrollVPort_ *ScrVP
RethinkDisplay_
Use Palette 0
Menus Off
If *ScrVP\DHeight<>PrefDisplayHeight
Forbid{}
*Scr\Height=PrefDisplayHeight ; Enforce y clipping
Permit{}
EndIf
ScreenToFront_ *Scr
Function Return True
Else
Permit{}
Function Return False
EndIf
End Function
.Main
Pic$="5Ms.IFF"
#Objects=30
#UnQ=-1 ; Wether or not to unqueue the objects
;Init
MCPU CPUminimum ; The two most important
Mc2pCPUmode CPUminimum ; lines in your program!
Mc2pWindow 0,PrefDisplayWidth,PrefDisplayHeight
InitBank 0,PrefDisplayWidth*PrefDisplayHeight,$10000
CludgeBitMap 0,PrefDisplayWidth,PrefDisplayHeight,8,Bank(0)
InitPalette 0,256
LoadBitMap 0,Pic$,0
;Make a chunky shape
If MShape(0,64,64)=0 Then End
MPlanar16ToShape 0,Bank(0),64,64,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie 0
s=1
For y=0 To 32 Step 32
For x=0 To 32 Step 32
If MShape(s,32,32)=0 Then End
MPlanar16ToShape s,Bank(0)+((PrefDisplayWidth/8)*y)+(x/8)+(64/8),32,32,PrefDisplayWidth,PrefDisplayHeight
MMakeCookie s
s+1
Next x
Next y
Free Bank 0
.Move
;Set up movement tables
Dim x.w(#Objects)
Dim y.w(#Objects)
Dim xdirection.b(#Objects)
Dim ydirection.b(#Objects)
Dim xdirectionswap.b(#Objects)
Dim ydirectionswap.b(#Objects)
For obj=1 To #Objects
x(obj)=Rnd(PrefDisplayWidth-48)+16
y(obj)=Rnd(PrefDisplayHeight-48)+16
Repeat
xdirection(obj)=Rnd(8)-4
Until xdirection(obj)<>0
Repeat
ydirection(obj)=Rnd(8)-4
Until ydirection(obj)<>0
xdirectionswap(obj)=-xdirection(obj)
ydirectionswap(obj)=-ydirection(obj)
Next obj
.Prepare
If InitDisplay{"Game"}=False Then Goto Finish
ShowPalette 0
Multitasking{On}
If MBitmap(1,PrefDisplayWidth,PrefDisplayHeight)=0 Then End
MAutoStencil On
If MBitmap(0,PrefDisplayWidth,PrefDisplayHeight)=0 Then End
*RP._RastPort=RastPort(0)
MCludgeBitmap 4,PrefDisplayWidth,PrefDisplayHeight*PrefDisplayBuffering,*RP\_BitMap\Planes-16
MUseBitmap 0
MUseShape 0
MClsStencil 0
For yy=0 To PrefDisplayHeight-64 Step 64
For xx=0 To PrefDisplayWidth-64 Step 64
MSBlock xx,yy
Next xx
Next yy
MUseBitmap 1
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,0,0
MUseBitmap 0
MQSBlitCut On
MSBlitCut On
MQueue 0,#Objects
.Table
VWait 5
MTable 0,256*256
If ReadFile(0,"Bounce.Table")=0 Then Goto Finish
ReadMem 0,MTablePtr,256*256
CloseFile 0
;Dim R(256),G(256),B(256)
;PaletteInfo 0
;For c=0 To 255
; R(c)=AGAPalRed(c)
; G(c)=AGAPalGreen(c)
; B(c)=AGAPalBlue(c)
;Next c
;TP.l=MTablePtr
;For SourceColour=0 To 255
; For DestColour=0 To 255
; Offset.l=(SourceColour LSL 8)+DestColour
; If SourceColour>0 ; only change pixels within the shape
; R0=(R(SourceColour)*0.2)+(R(DestColour)*0.8)
; G0=(G(SourceColour)*0.2)+(G(DestColour)*0.8)
; B0=(B(SourceColour)*0.2)+(B(DestColour)*0.8)
; ;R0=Max((R(SourceColour)-R(DestColour)),0)
; ;G0=Max((G(SourceColour)-G(DestColour)),0)
; ;B0=Max((B(SourceColour)-B(DestColour)),0)
; ;R0=R(DestColour)*0.8
; ;G0=G(DestColour)*0.8
; ;B0=B(DestColour)*0.8
; Else ; leave pixels of colour 0 as background
; R0=R(DestColour)
; G0=G(DestColour)
; B0=B(DestColour)
; EndIf
; Best=0
; BestTotal.l=$0FFFFFFF
; For TestColour=0 To 255
; R1=R(TestColour)
; G1=G(TestColour)
; B1=B(TestColour)
; Total.l=((R0-R1)*(R0-R1))+((G0-G1)*(G0-G1))+((B0-B1)*(B0-B1))
; If Abs(Total)<BestTotal
; Best=TestColour
; BestTotal=Abs(Total)
; EndIf
; Next TestColour
; Poke.b TP+Offset,Best
; Next DestColour
;Next SourceColour
;;*** runtime ***
;;Save Off the generated table here
;If WriteFile(0,"Bounce.Table2")=False Then Goto Finish
;WriteMem 0,MTablePtr,256*256
;CloseFile 0
MBlitMode MReMapMode
MQBlitMode MReMapMode
MSBlitMode MReMapMode
MQSBlitMode MReMapMode
.Loop
buf.b=0
its.l=0
*Ras.RasInfo=*ScrVP\RasInfo
ResetTimer
While Joyb(0)=0 AND Joyb(1)=0
For obj=1 To #Objects
;Move
x(obj)+xdirection(obj)
If x(obj)<4 OR x(obj)>PrefDisplayWidth-36 Then Exchange xdirection(obj),xdirectionswap(obj)
y(obj)+ydirection(obj)
If y(obj)<4 OR y(obj)>PrefDisplayHeight-36 Then Exchange ydirection(obj),ydirectionswap(obj)
;Try changing this to a different type of blit. If it's not a Q-type blit, comment-out the unqueue line also
MQBlit (obj MOD 4)+1,x(obj),y(obj) ; Stencil-cut blit and add to queue
Next obj
;Display
If IsAGA
ShowBitMap buf
If PrefDisplayBuffering>1
buf+1
If buf=PrefDisplayBuffering Then buf=0
EndIf
Mc2p MBitmapPtr(buf),PlanarBuf(buf)
Else
*ScrVP\DyOffset=-buf*PrefDisplayHeight
; *Ras\RyOffset=buf*PrefDisplayHeight
ScrollVPort_ *ScrVP
; *RP._RastPort=RastPort(buf)
; WritePixelArray8_ *RP,0,0,PrefDisplayWidth-1,PrefDisplayHeight-1,MBitmapPtr(0),0
If PrefDisplayBuffering>1
buf+1
If buf=PrefDisplayBuffering Then buf=0
EndIf
MUseBitmap 4
MBlockScroll 0,0,PrefDisplayWidth,PrefDisplayHeight,0,PrefDisplayHeight*buf,0
MUseBitmap 0
EndIf
;Comment this line out if not using a queued blit
If #UnQ
MUnQueue 0,1
EndIf
; MFlushQueue 0
its+1
Wend
;Report
t=Timer
t=Max(t,1)
its=Max(its,1)
a.q=50.0/(t/its)
WBenchToFront_
FindScreen 1
Window 2,16,16,300,40,0,"Test results",1,0
WindowOutput 2
NPrint a," frames per second"
NPrint " "
NPrint "Press mouse/joy button..."
Repeat
Until Joyb(0)<>0 OR Joyb(1)<>0
Finish:
Multitasking{On}
End